home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / SWidget.tcl.z / SWidget.tcl
Encoding:
Text File  |  1999-01-26  |  10.0 KB  |  491 lines
  1. # SWidget.tcl --
  2. #
  3. #     tixScrolledWidget: virtual base class. Do not instantiate
  4. #    This is the core class for all scrolled widgets.
  5. #
  6. # Copyright (c) 1996, Expert Interface Technologies
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11.  
  12.  
  13. tixWidgetClass tixScrolledWidget {
  14.     -virtual true
  15.     -classname TixScrolledWidget
  16.     -superclass tixPrimitive
  17.     -method {
  18.     }
  19.     -flag {
  20.     -scrollbar -scrollbarspace
  21.     }
  22.     -configspec {
  23.     {-scrollbar scrollbar Scrollbar both}
  24.     {-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
  25.     }
  26. }
  27.  
  28. proc tixScrolledWidget:InitWidgetRec {w} {
  29.     upvar #0 $w data
  30.  
  31.     tixChainMethod $w InitWidgetRec
  32.  
  33.     set data(x,first)   0
  34.     set data(x,last)    0
  35.  
  36.     set data(y,first)   0
  37.     set data(y,last)    0
  38.  
  39.     set data(lastSpec) ""
  40.     set data(lastMW)   ""
  41.     set data(lastMH)   ""
  42.     set data(lastScbW) ""
  43.     set data(lastScbH) ""
  44.  
  45.     set data(repack)    0
  46.     set data(counter)   0
  47.  
  48.     set data(vsbPadY)   0
  49.     set data(hsbPadX)   0
  50. }
  51.  
  52. proc tixScrolledWidget:SetBindings {w} {
  53.     upvar #0 $w data
  54.  
  55.     tixChainMethod $w SetBindings
  56.  
  57.     tixManageGeometry $data(pw:client) "tixScrolledWidget:ClientGeomProc $w"
  58.     bind $data(pw:client) <Configure> \
  59.     [list tixScrolledWidget:ClientGeomProc $w "" $data(pw:client)]
  60.  
  61.     tixManageGeometry $data(w:hsb) "tixScrolledWidget:ClientGeomProc $w"
  62.     bind $data(w:hsb) <Configure> \
  63.     [list tixScrolledWidget:ClientGeomProc $w "" $data(w:hsb)]
  64.  
  65.     tixManageGeometry $data(w:vsb) "tixScrolledWidget:ClientGeomProc $w"
  66.     bind $data(w:vsb) <Configure> \
  67.     [list tixScrolledWidget:ClientGeomProc $w "" $data(w:vsb)]
  68.  
  69.     bind $w <Configure> "tixScrolledWidget:MasterGeomProc $w"
  70.  
  71.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  72.     set data(repack) 1
  73. }
  74.  
  75. proc tixScrolledWidget:config-scrollbar {w value} {
  76.     upvar #0 $w data
  77.  
  78.     if {[lindex $value 0] == "auto"} {
  79.     foreach xspec [lrange $value 1 end] {
  80.         case $xspec {
  81.         {+x -x +y -y} {}
  82.         default {
  83.             error "bad -scrollbar value \"$value\""
  84.         }
  85.         }
  86.     }
  87.     } else {
  88.     case $value in {
  89.         {none x y both} {}
  90.         default {
  91.         error "bad -scrollbar value \"$value\""
  92.         }
  93.     }
  94.     }
  95.  
  96.     if {$data(repack) == 0} {
  97.     set data(repack) 1
  98.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  99.     }
  100. }    
  101.  
  102. proc tixScrolledWidget:config-scrollbarspace {w value} {
  103.     upvar #0 $w data
  104.   
  105.     if {$data(repack) == 0} {
  106.     set data(repack) 1
  107.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  108.     }
  109. }    
  110.  
  111.  
  112. #----------------------------------------------------------------------
  113. #
  114. #         Scrollbar calculations
  115. #
  116. #----------------------------------------------------------------------
  117. proc tixScrolledWidget:ClientGeomProc {w type client} {
  118.     upvar #0 $w data
  119.  
  120.     if {$data(repack) == 0} {
  121.     set data(repack) 1
  122.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  123.     }
  124. }
  125.  
  126. proc tixScrolledWidget:MasterGeomProc {w} {
  127.     upvar #0 $w data
  128.  
  129.     if {$data(repack) == 0} {
  130.     set data(repack) 1
  131.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  132.     }
  133. }
  134.  
  135. proc tixScrolledWidget:Configure {w} {
  136.     if {![winfo exists $w]} {
  137.     return
  138.     }
  139.  
  140.     upvar #0 $w data
  141.  
  142.     if {$data(repack) == 0} {
  143.     set data(repack) 1
  144.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  145.     }
  146. }
  147.  
  148. proc tixScrolledWidget:ScrollCmd {w scrollbar axis first last} {
  149.     upvar #0 $w data
  150.  
  151.     $scrollbar set $first $last
  152. }
  153.  
  154. # Show or hide the scrollbars as required.
  155. #
  156. # spec: 00 = need none
  157. # spec: 01 = need y
  158. # spec: 10 = need x
  159. # spec: 11 = need xy
  160. #
  161. proc tixScrolledWidget:Repack {w} {
  162.     tixCallMethod $w RepackHook
  163. }
  164.  
  165. proc tixScrolledWidget:RepackHook {w} {
  166.     upvar #0 $w data
  167.  
  168.     if {![winfo exists $w]} {
  169.     # This was generated by the <Destroy> event
  170.     #
  171.     return
  172.     }
  173.  
  174.     set client $data(pw:client)
  175.  
  176.     # Calculate the size of the master
  177.     #
  178.     set mreqw [winfo reqwidth  $w]
  179.     set mreqh [winfo reqheight $w]
  180.     set creqw [winfo reqwidth  $client]
  181.     set creqh [winfo reqheight $client]
  182.  
  183.     set scbW [winfo reqwidth  $w.vsb]
  184.     set scbH [winfo reqheight $w.hsb]
  185.  
  186.     case $data(-scrollbarspace) {
  187.     "x" {
  188.         incr creqh $scbH
  189.     }
  190.     "y" {
  191.         incr creqw $scbW
  192.     }
  193.     "both" {
  194.         incr creqw $scbW
  195.         incr creqh $scbH
  196.     }
  197.     }
  198.  
  199.     if {$data(-width) != 0} {
  200.     set creqw $data(-width)
  201.     }
  202.     if {$data(-height) != 0} {
  203.     set creqh $data(-height)
  204.     }
  205.  
  206.     if {$mreqw != $creqw || $mreqh != $creqh } {
  207.     if {![info exists data(counter)]} {
  208.         set data(counter) 0
  209.     }
  210.     if {$data(counter) < 50} {
  211.         incr data(counter)
  212.         tixGeometryRequest $w $creqw $creqh
  213.         tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  214.         set data(repack) 1
  215.         return
  216.     }
  217.     }
  218.  
  219.     set data(counter) 0
  220.     set mw [winfo width  $w]
  221.     set mh [winfo height $w]
  222.  
  223.     set cw [expr $mw - $scbW]
  224.     set ch [expr $mh - $scbH]
  225.  
  226.     set scbx [expr $mw - $scbW]
  227.     set scby [expr $mh - $scbH]
  228.  
  229.     # Check the validity of the sizes: if window was not mapped then
  230.     # sizes will be below 1x1
  231.     if {$cw < 1} {
  232.     set cw 1
  233.     }
  234.     if {$ch < 1} {
  235.     set ch 1
  236.     }
  237.     if {$scbx < 1} {
  238.     set scbx 1
  239.     }
  240.     if {$scby < 1} {
  241.     set scby 1
  242.     }
  243.  
  244.     if {[lindex $data(-scrollbar) 0] == "auto"} {
  245.     # Find out how we are going to pack the scrollbars
  246.     #
  247.     set spec [tixScrolledWidget:CheckScrollbars $w $scbW $scbH]
  248.  
  249.     foreach xspec [lrange $data(-scrollbar) 1 end] {
  250.         case $xspec {
  251.         +x {
  252.             set spec [expr $spec | 10]
  253.         }
  254.         -x {
  255.             set spec [expr $spec & 01]
  256.         }
  257.         +y {
  258.             set spec [expr $spec | 01]
  259.         }
  260.         -y {
  261.             set spec [expr $spec & 10]
  262.         }
  263.         }
  264.     }
  265.     if {$spec == 0} {
  266.         set spec 00
  267.     }
  268.     if {$spec == 1} {
  269.         set spec 01
  270.     }
  271.     } else {
  272.     case $data(-scrollbar) in {
  273.         none {
  274.         set spec 00
  275.         }
  276.         x {
  277.         set spec 10
  278.         }
  279.         y {
  280.         set spec 01
  281.         }
  282.         both {
  283.         set spec 11
  284.         }
  285.     }
  286.     }
  287.  
  288.  
  289.     if {$data(lastSpec)==$spec && $data(lastMW)==$mw && $data(lastMH)==$mh} {
  290.     if {$data(lastScbW) == $scbW && $data(lastScbH) == $scbH} {
  291.         tixCallMethod $w PlaceWindow
  292.         set data(repack) 0
  293.         return
  294.     }
  295.     }
  296.  
  297.     set vsbH [expr $mh - $data(vsbPadY)]
  298.     set hsbW [expr $mw - $data(hsbPadX)]
  299.  
  300.     if {$vsbH < 1} {
  301.     set vsbH 1
  302.     }
  303.     if {$hsbW < 1} {
  304.     set hsbW 1
  305.     }
  306.  
  307.     case $spec in {
  308.     "00" {
  309.         tixMoveResizeWindow $client 0 0 $mw $mh
  310.  
  311.         tixMapWindow $client
  312.             tixUnmapWindow $data(w:hsb)
  313.         tixUnmapWindow $data(w:vsb)
  314.     }
  315.     "01" {
  316.         tixMoveResizeWindow $client 0 0 $cw $mh
  317.         tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
  318.  
  319.         tixMapWindow $client
  320.         tixUnmapWindow $data(w:hsb)
  321.         tixMapWindow $data(w:vsb)
  322.     }
  323.     "10" {
  324.         tixMoveResizeWindow $client 0 0 $mw $ch
  325.         tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH 
  326.  
  327.         tixMapWindow $client
  328.         tixMapWindow $data(w:hsb)
  329.         tixUnmapWindow $data(w:vsb)
  330.     }
  331.     "11" {
  332.         set vsbH [expr $ch - $data(vsbPadY)]
  333.         set hsbW [expr $cw - $data(hsbPadX)]
  334.         if {$vsbH < 1} {
  335.         set vsbH 1
  336.         }
  337.         if {$hsbW < 1} {
  338.         set hsbW 1
  339.         }
  340.  
  341.         tixMoveResizeWindow $client 0 0 $cw $ch
  342.         tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
  343.         tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH 
  344.  
  345.         tixMapWindow $client
  346.         tixMapWindow $data(w:hsb)
  347.         tixMapWindow $data(w:vsb)
  348.     }
  349.     }
  350.  
  351.     set data(lastSpec) $spec
  352.     set data(lastMW)   $mw
  353.     set data(lastMH)   $mh
  354.     set data(lastScbW) $scbW
  355.     set data(lastScbH) $scbH
  356.  
  357.     tixCallMethod $w PlaceWindow
  358.     set data(repack) 0
  359. }
  360.  
  361. proc tixScrolledWidget:PlaceWindow {w} {
  362.     # virtual base function
  363. }
  364.  
  365. #
  366. # Helper function
  367. #
  368. proc tixScrolledWidget:NeedScrollbar {w axis} {
  369.     upvar #0 $w data
  370.  
  371.     if {$data($axis,first) > 0.0} {
  372.     return 1
  373.     }
  374.  
  375.     if {$data($axis,last) < 1.0} {
  376.     return 1
  377.     }
  378.     
  379.     return 0
  380. }
  381.  
  382. # Return whether H and V needs scrollbars in a list of two booleans
  383. #
  384. #
  385. proc tixScrolledWidget:CheckScrollbars {w scbW scbH} {
  386.     upvar #0 $w data
  387.  
  388.     set mW [winfo width  $w]
  389.     set mH [winfo height $w]
  390.  
  391.     set info [tixCallMethod $w GeometryInfo $mW $mH]
  392.  
  393.     if {$info != ""} {
  394.     set xSpec [lindex $info 0]
  395.     set ySpec [lindex $info 1]
  396.  
  397.     set data(x,first)   [lindex $xSpec 0]
  398.     set data(x,last)    [lindex $xSpec 1]
  399.  
  400.     set data(y,first)   [lindex $ySpec 0]
  401.     set data(y,last)    [lindex $ySpec 1]
  402.     }
  403.  
  404.     set needX [tixScrolledWidget:NeedScrollbar $w x]
  405.     set needY [tixScrolledWidget:NeedScrollbar $w y]
  406.  
  407.     if {[winfo ismapped $w]==0} {
  408.     return "$needX$needY"
  409.     }
  410.  
  411.     if {$needX && $needY} {
  412.     return 11
  413.     }
  414.  
  415.     if {$needX == 0 && $needY == 0} {
  416.     return 00
  417.     }
  418.  
  419.     if {$needX} {
  420.     set mH [expr $mH - $scbH]
  421.     }
  422.     if {$needY} {
  423.     set mW [expr $mW - $scbW]
  424.     }
  425.  
  426.     set info [tixCallMethod $w GeometryInfo $mW $mH]
  427.     if {$info != ""} {
  428.     set xSpec [lindex $info 0]
  429.     set ySpec [lindex $info 1]
  430.  
  431.     set data(x,first)   [lindex $xSpec 0]
  432.     set data(x,last)    [lindex $xSpec 1]
  433.  
  434.     set data(y,first)   [lindex $ySpec 0]
  435.     set data(y,last)    [lindex $ySpec 1]
  436.     }
  437.  
  438.     set needX [tixScrolledWidget:NeedScrollbar $w x]
  439.     set needY [tixScrolledWidget:NeedScrollbar $w y]
  440.  
  441.     return "$needX$needY"
  442. }
  443.  
  444. #----------------------------------------------------------------------
  445. # Following is a bunch of crap. Not needed in TK 4.0.
  446. #----------------------------------------------------------------------
  447.  
  448. #----------------------------------------------------------------------
  449. # Keyboard events -
  450. #
  451. #    Raw event handlers: redirect binding events to class methods
  452. #
  453. proc tixScrolledWidget:RawUpKey {w} {
  454.     tixCallMethod $w HandleLineUp
  455. }
  456.  
  457. proc tixScrolledWidget:RawDownKey {w} {
  458.     tixCallMethod $w HandleLineDown
  459. }
  460.  
  461. proc tixScrolledWidget:RawLeftKey {w} {
  462.     tixCallMethod $w HandleLeftKey
  463. }
  464.  
  465. proc tixScrolledWidget:RawRightKey {w} {
  466.     tixCallMethod $w HandleRightKey
  467. }
  468.  
  469. proc tixScrolledWidget:RawPriorKey {w} {
  470.     tixCallMethod $w HandlePageUp
  471. }
  472.  
  473. proc tixScrolledWidget:RawNextKey {w} {
  474.     tixCallMethod $w HandlePageDown
  475. }
  476.  
  477. # Virtual event handlers: subclasses can derive from these functions
  478. #
  479.  
  480. proc tixScrolledWidget:HandleLineUp {w} {}
  481.  
  482. proc tixScrolledWidget:HandleLineDown {w} {}
  483.  
  484. proc tixScrolledWidget:HandlePageUp {w} {}
  485.  
  486. proc tixScrolledWidget:HandlePageDown {w} {}
  487.  
  488. proc tixScrolledWidget:HandleLeftKey {w} {}
  489.  
  490. proc tixScrolledWidget:HandleRightKey {w} {}
  491.